home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / numconv / numconv.ex_ / numconv.ex / 3081 / SOURCE / 3 < prev    next >
Encoding:
Text File  |  1999-07-20  |  1.4 KB  |  47 lines
  1. Attribute VB_Name = "mdlRoman"
  2. Function Num2Roman(Number)
  3. On Error GoTo Error
  4. Number = Abs(Int(Val(Number)))
  5. If Number = 0 Or Number > 3999 Then GoTo Error
  6. Number = CStr(Number)
  7. For i = 1 To Len(Number)
  8.     Num2Roman = SingleDigit(Val(Left(Right(Number, i), 1)), Val("1" & String(i - 1, "0"))) & Num2Roman
  9. Next i
  10. Exit Function
  11. Error:
  12. Num2Roman = "Error"
  13. End Function
  14.  
  15. Function Letter(LetterValue As Integer)
  16. Select Case LetterValue
  17. Case 1: Letter = "I"
  18. Case 5: Letter = "V"
  19. Case 10: Letter = "X"
  20. Case 50: Letter = "L"
  21. Case 100: Letter = "C"
  22. Case 500: Letter = "D"
  23. Case 1000: Letter = "M"
  24. End Select
  25. End Function
  26.  
  27. Function SingleDigit(Number As Byte, Multiplier As Integer)
  28. Select Case Number
  29. Case 1: SingleDigit = Letter(Multiplier)
  30. Case 2: SingleDigit = Repeat(2, Letter(Multiplier))
  31. Case 3: SingleDigit = Repeat(3, Letter(Multiplier))
  32. Case 4: SingleDigit = Letter(Multiplier) & Letter(Multiplier * 5)
  33. Case 5: SingleDigit = Letter(Multiplier * 5)
  34. Case 6: SingleDigit = Letter(Multiplier * 5) & Letter(Multiplier)
  35. Case 7: SingleDigit = Letter(Multiplier * 5) & Repeat(2, Letter(Multiplier))
  36. Case 8: SingleDigit = Letter(Multiplier * 5) & Repeat(3, Letter(Multiplier))
  37. Case 9: SingleDigit = Letter(Multiplier) & Letter(Multiplier * 10)
  38. Case 0: SingleDigit = ""
  39. End Select
  40. End Function
  41.  
  42. Function Repeat(Repetitions As Long, Expression As String)
  43. For i = 1 To Repetitions
  44. Repeat = Repeat & Expression
  45. Next i
  46. End Function
  47.